GS <- mutate(GS,Date = as.Date(Date, format = "%d-%b-%y"))
GSxts <- tk_xts(GS)
## Warning in tk_xts_.data.frame(data = data, select = select, date_var =
## date_var, : Non-numeric columns being dropped: Date
## Using column `Date` for date_var.
allDates = index(GSxts)
firstDate <- min(allDates)
lastDate <- max(allDates)-30 #find the last start_date
while(!lastDate %in% allDates)
  lastDate <- lastDate-1

result <- data.frame(`StartDate` = as.Date(character()), `OptionPnL` = double(), `HedgingPnL` = double(), `FinalPnL` = double(), `MaxDrawdown` = double(), `SharpeRatio` = double(),`StartPrice`= double(), `EndPrice` = double(), `AvgPrice` = double(), `AvgGrowthRate` = double(), `Volatility` = double(), `Profitability` = double())
startD <- firstDate
for(startD in firstDate:lastDate){
  startD <- as.Date(startD)
  if(startD %in% allDates){
    endD <- startD+30
    #adjust the end date backwards if end date (a calendar day) is not in the xts
    while(!endD %in% allDates)
      endD <- endD-1
    
    xts_obj <- GSxts[paste(c(startD,endD),collapse = "/")]
    
    quantity = 100
    dates <- index(xts_obj)
    start_date <- min(dates)
    end_date <- max(dates)
    start_price <- as.numeric(xts_obj[start_date, "Close"])
    start_volatility <- as.numeric(xts_obj[start_date, "IV30"])
    
    df <- tibble(Date = dates)
    df$Close <- coredata(xts_obj[, "Close"])
    #df$IV30 <- coredata(xts_obj[, "IV30"])
    avgChange <- as.numeric(mean(xts_obj[, "PChg"],na.rm=TRUE))
    #X <- start_price
    #sigma = start_volatility
    r <- 0.8 / 100
    # Vary S and Time everyday
    #S <- df$Close
    #Time <- (end_date - df$Date) / 365
    
    #GBSOption(TypeFlag, S, X, Time, r, b, sigma)@price
    
    df_opt <- rowwise(df) %>%
    #this is the premium for one unit of call option  
    mutate(premium = GBSOption(TypeFlag = "c",
    S = Close,
    X = as.numeric(start_price),
    Time = as.numeric((end_date - Date) / 365),
    r = r, # interest rate
    b = 1.85/100, # dividend yield obtained from https://www.dividend.com/dividend-stocks/financial/investment-brokerage-national/gs-goldman-sachs/
    sigma = as.numeric(start_volatility/100))@price,
    
    #this is the delta of a call option (before negation)
    delta_hedge = GBSGreeks("delta", TypeFlag = "c", 
                            S = Close, 
                            X = as.numeric(start_price), 
                            Time = as.numeric((end_date - Date) / 365), 
                            r = r, 
                            b = 1.85/100, 
                            sigma = as.numeric(start_volatility/100))) %>%
    ungroup() %>%
      
    #delta hedging strategy selected: SHORT CALL LONG STOCK (from BlackS Scholes formula, such strategy should approximate a long position in risk free)
    mutate(Option_DoD_PnL = ifelse(Date == start_date, # On the 1st date, we count the cost of buying the option
    0, #quantity*premium, #on the first day, receive the call option premium and short the option
    -quantity*(premium - Lag(premium))), #if subsequently call option price rises, there is a loss
    
    Hedging_DoD_Pnl = ifelse(Date == start_date, 0, quantity * Lag(delta_hedge) * (Close - Lag(Close))),
                             
    
    DoD_PnL = Option_DoD_PnL + Hedging_DoD_Pnl) %>%
    mutate(PortValue = quantity*(-premium + delta_hedge*Close),
           Profitability = DoD_PnL/Lag(PortValue),
           PnL_to_date = cumsum(DoD_PnL),
           HPnL_to_date = cumsum(Hedging_DoD_Pnl), 
           OPnL_to_date = cumsum(Option_DoD_PnL))
    
    maxDrawDown <- {
    xs <- df_opt$PnL_to_date
    max(cummax(xs) - cummin(xs))
    }
    
    #The initial outflow of funds is the cost to buy stocks minus option premium received 
    #InitialInvt = (df_opt[[1,"delta_hedge"]]*df_opt[[1,"Close"]] - df_opt[[1,"premium"]])*quantity #OUTFLOW of funds
    #profitability = df_opt[df_opt$Date==end_date,"PnL_to_date"]/InitialInvt
    #df_opt<-mutate(df_opt, PortValue = InitialInvt + PnL_to_date, PortReturn = DoD_PnL/Lag(PortValue))
    
    #ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Option_DoD_PnL),color = "blue") + ggtitle("option profit - TTM"))
    #ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Hedging_DoD_Pnl))+ggtitle("stock profit - TTM"))
    
    #renderTable(tail(df_opt,1))
    
    
    #renderText(paste0("the Sharpe Ratio is ",round(SR,4)))
    #renderText(paste0("The maximum drawdown is ", round(maxDrawDown,4)))
    hedgingPnl <- as.numeric(df_opt[df_opt$Date==end_date,"HPnL_to_date"])
    finalPnl <- as.numeric(df_opt[df_opt$Date==end_date,"PnL_to_date"])
    optionPnl <- as.numeric(df_opt[df_opt$Date==end_date,"OPnL_to_date"])
    endPrice <- as.numeric(df_opt[df_opt$Date==end_date,"Close"])
    avgPrice <- as.numeric(mean(df_opt$Close,na.rm=TRUE))
    volatility <- stdev(df_opt$Profitability, na.rm = TRUE)*sqrt(252) #annualised volatility
    profitability <- 12*(as.numeric(tail(cumprod(na.omit(df_opt$Profitability+1)),1))-1) #annualized profitability
    SR <- as.numeric((profitability-r)/volatility) #  annual SR
    result <- rbind(result,data.frame("StartDate" = start_date, "OptionPnL" = optionPnl, "HedgingPnL" = hedgingPnl, "FinalPnL" = finalPnl, "MaxDrawdown" = maxDrawDown, "SharpeRatio" = SR,"StartPrice"=start_price , "EndPrice" = endPrice, "AvgPrice" = avgPrice, "AvgGrowthRate" = avgChange, "Volatility" = volatility, "Profitability" = profitability))
    
  }}
    ggplotly(p = ggplot(GS) + geom_line(aes(Date, Close, label = PChg))+ggtitle("Stock Price with percentage change")) #stock close price
## Warning: Ignoring unknown aesthetics: label
    ggplot(GS) + geom_density(aes(Close)) #density of close price

     ggplot(result) + geom_density(aes(MaxDrawdown)) + ggtitle("distribution of max drawdown")

    kable(result%>% summarise(`MDD Mean` = mean(MaxDrawdown),`MDD volatility` = stdev(MaxDrawdown, na.rm = TRUE), `MDD Median` = median(MaxDrawdown))) %>% kable_styling(bootstrap_options = c("striped","hover"))
MDD Mean MDD volatility MDD Median
244.986 211.6976 180.2422 
    kable(result%>% summarise(`Mean Profitability` = mean(Profitability),`return volatility` = stdev(Profitability, na.rm = TRUE), `Mean PnL` = mean(FinalPnL), `PnL Volatility` = stdev(FinalPnL))) %>% kable_styling(bootstrap_options = c("striped","hover"))
Mean Profitability return volatility Mean PnL PnL Volatility
-0.4458225 1.987506 -64.60084 284.6956 
    kable(result%>% summarise(`99% VAR` = -min(quantile(FinalPnL,.01),0),`95% VAR` = -min(quantile(FinalPnL,0.05),0))) %>% kable_styling(bootstrap_options = c("striped","hover"))
99% VAR 95% VAR
1000.471 711.4319 
    ggplot(result) + geom_density(aes(FinalPnL),color = "blue") + 
      geom_density(aes(OptionPnL),color = "red") + 
      geom_density(aes(HedgingPnL)) + ggtitle("distribution of PnLs")

    ggplotly(p=ggplot(result) + geom_point(aes(AvgPrice,FinalPnL, label = StartDate)) + ggtitle("avg price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
    ggplotly(p=ggplot(result) + geom_point(aes(AvgGrowthRate,FinalPnL, label = AvgPrice))+ggtitle("avg growth rate - final pnl"))
## Warning: Ignoring unknown aesthetics: label
    ggplotly(p=ggplot(result) + geom_point(aes(StartPrice,FinalPnL, label = EndPrice))+ggtitle("start price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
    ggplotly(p=ggplot(result) + geom_point(aes(EndPrice,FinalPnL, label = StartPrice))+ggtitle("end price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
    p1 <- ggplot(result) + geom_point(aes(AvgPrice, OptionPnL)) + ggtitle("avg price - option pnl") #+ xlim(150,300) + ylim(150,300) + coord_fixed(ratio = 1)
    p2 <- ggplot(result) + geom_point(aes(AvgPrice, HedgingPnL)) + ggtitle("avg price - hedging pnl") #+ xlim(150,300) + ylim(150,300) + coord_fixed(ratio = 1)
    grid.arrange(p1,p2,nrow = 1)

    a1 <- ggplot(result) + geom_point(aes(AvgGrowthRate,OptionPnL)) + 
      ggtitle("avg growth rate - option pnl")
    a2 <- ggplot(result) + geom_point(aes(AvgGrowthRate,HedgingPnL)) + 
      ggtitle("avg growth rate - hedging pnl")
    grid.arrange(a1,a2, nrow = 1)

     a3 <- ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = OptionPnL), size = 0.8, alpha = 0.7)+ggtitle("start & end price - option pnl") + xlim(150,280) + ylim(150,280) + coord_fixed(ratio = 1) + geom_abline(mapping = NULL, data = NULL, slope = 1, intercept = 0, show.legend = NA)
    a4 <- ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = HedgingPnL), size = 0.8, alpha = 0.7)+ggtitle("start & end price - hedging pnl") + xlim(150,280) + ylim(150,280) + coord_fixed(ratio = 1) + geom_abline(mapping = NULL, data = NULL, slope = 1, intercept = 0, show.legend = NA)
     grid.arrange(a3,a4, nrow=1)

Comparing the the hedging and option PnL, we clearly see a hedging relationship between option and stock position in this strategy.As average growth rate increase, the dispersion of FinalPnL gets bigger, which means the portfolio has not been completely hedged.

Sharpe ratio doesn’t have significant correlation with average growth rate, which means hedging is relatively successful and the portfolio generally has less exposure to stock’s risk.

Comparing these results with the backtesting results of 25% delta options, the profitability and volitility are significantly smaller and less extreme.

     kable(head(result,20))%>%kable_styling(bootstrap_options = c("striped","hover"))
StartDate OptionPnL HedgingPnL FinalPnL MaxDrawdown SharpeRatio StartPrice EndPrice AvgPrice AvgGrowthRate Volatility Profitability
2017-12-13 463.0454 -168.53684 294.508593 294.5086 9.9100330 255.56 257.03 256.1119 -0.0000952 0.0302113 0.3073954
2017-12-14 441.4060 -163.08038 278.325614 287.2598 9.1438185 255.48 257.03 256.1395 0.0003000 0.0305846 0.2876602
2017-12-15 592.4204 -283.10487 309.315485 324.3859 7.9829667 257.17 257.03 256.1742 0.0003158 0.0589236 0.4783850
2017-12-18 629.6078 -431.73718 197.870624 319.7264 3.5074328 260.02 253.65 256.1125 -0.0007000 0.0781903 0.2822474
2017-12-19 644.4881 -427.02857 217.459540 335.8817 4.0982381 256.48 250.97 255.6600 -0.0018000 0.0455551 0.1946957
2017-12-20 555.9713 -372.84239 183.128916 318.5387 -1.1386019 255.18 256.12 255.6420 -0.0000500 0.1055910 -0.1122261
2017-12-21 659.1798 -417.25831 241.921539 301.0003 5.8096937 261.01 256.12 255.6663 0.0002105 0.1025522 0.6037971
2017-12-22 645.1820 -393.99104 251.190956 319.6960 5.6971431 258.97 256.12 255.3694 -0.0010556 0.1011386 0.5842012
2017-12-26 -477.5047 555.71383 78.209142 212.0976 1.2759400 257.72 269.03 256.8571 0.0018571 0.0431973 0.0631171
2017-12-27 -578.7691 649.42209 70.652979 195.4156 1.3296562 255.95 268.14 257.3533 0.0019524 0.0348957 0.0543993
2017-12-28 -533.5051 590.57885 57.073751 184.7936 0.9145182 256.50 268.14 257.4235 0.0024000 0.0375990 0.0423850
2017-12-29 -700.4934 782.79560 82.302253 187.6953 1.7764516 254.76 268.14 257.4721 0.0024211 0.0323652 0.0654952
2018-01-02 -1025.2362 1039.27684 14.040625 111.2124 -0.1385077 255.67 272.23 259.9432 0.0030909 0.0237767 0.0047067
2018-01-03 -61.6881 69.86149 8.173396 103.0052 -0.3816456 253.29 260.04 260.1418 0.0008636 0.0193968 0.0005973
2018-01-04 313.1923 -283.36460 29.827673 112.2717 0.4504615 256.83 260.04 260.4681 0.0013333 0.0252566 0.0193771
2018-01-05 176.1221 -147.80806 28.314053 105.5138 0.4630396 255.52 260.04 260.6500 0.0007000 0.0234081 0.0188389
2018-01-08 100.8751 -695.17910 -594.303970 671.7118 -3.9357892 251.81 257.10 260.1086 0.0004091 0.2208346 -0.8611583
2018-01-09 652.6178 -1791.29506 -1138.677304 1212.3405 -4.9776631 253.94 246.35 259.8605 -0.0008182 0.2589307 -1.2808700
2018-01-10 650.7132 -1652.07217 -1001.359019 1063.8870 -4.2767678 254.33 249.30 259.6495 -0.0006364 0.2218538 -0.9408170
2018-01-11 667.2664 -1620.49312 -953.226706 1008.2097 -4.2137937 255.13 249.30 259.9029 -0.0007619 0.2360157 -0.9865214